open Printf

(* Exceptions *)
exception LocErr of string
exception ContErr of string
exception TabErr of string
exception SplitErr of string

(* Types *)
type size = int * int * int * int
type direction = H | V | N
type position = size * direction

type window = string

type 'a zipper = 'a Zip.t

type layout = position * layout_tree
and layout_tree = 
    Leaf of window zipper
  | Node of layout zipper

type parent = position * path
and path = 
    Top
  | Loc of parent * layout zipper

type location = layout * path

let _up (l,p) = match p with
    Top -> raise (LocErr "_up of Top")
  | Loc(par, lz) -> (fst par, Node(Zip.insert l lz)), snd par

let _down ((pos, l),p) = match l with
    Node lz -> Zip.get lz, Loc ((pos,p), Zip.delete lz)
  | _ -> raise (LocErr "_down of Leaf")

let _previous (l,p) = match p with
    Top -> raise (LocErr "_previous of Top")
  | Loc(par, lz) -> 
      let lz' = Zip.previous (Zip.insert l lz) in
      Zip.get lz', Loc(par, Zip.delete lz')

let _next (l,p) = match p with
    Top -> raise (LocErr "_next of Top")
  | Loc(par, lz) -> 
      let lz' = Zip.next (Zip.insert l lz) in
      Zip.get lz', Loc(par, Zip.delete lz')

let rec down ((pos,l),p) = match l with
    Node lz -> down (_down ((pos,l),p))
  | _ -> ((pos,l),p)

let rec up (l,p) = match p with
    Top -> (l,p)
  | _ -> up (_up (l,p))

let rec next (l,p) = 
  try 
    down (_next (l,p))
  with 
      Zip.End_of_zip -> down (next (_up (l,p)))
    | Zip.Out_of_bound -> down (next (_up (l,p)))

let rec previous (l,p) = 
  try 
    down (_previous (l,p))
  with 
      Zip.End_of_zip -> down (previous (_up (l,p)))
    | Zip.Out_of_bound -> down (previous (_up (l,p)))

let empty pos = ((pos,N),(Leaf Zip.empty))

let insert w ((pos,l),p) = match l with
    Leaf wz ->  (pos, Leaf (Zip.insert w wz)),p
  | _ -> raise (ContErr "insert in split")

let delete ((pos,l),p) = match p with
    Loc (par, plz) -> (Zip.get plz, (Loc(par, Zip.delete plz)))
  | Top -> raise (LocErr "delete from top")

let tab_next ((pos,l),p) = match l with
    Leaf lz -> ((pos, Leaf (Zip.next lz)), p)
  | _ -> raise (SplitErr "tab_next of split")

let tab_previous ((pos,l),p) = match l with
    Leaf lz -> ((pos, Leaf (Zip.previous lz)), p)
  | _ -> raise (SplitErr "tab_previous of split")

let rec split dir (((c,d),l),p) = 
  let splitsize ((x,y,w,h),d) = 
    printf "Splitting : %d, %d, %d, %d\n%!" x y w h;
    match d with
      H -> (x,y,w/2,h),(x+w/2,y,w-w/2,h)
    | V -> (x,y,w,h/2),(x,y+h/2,w,h-h/2)
    | N -> raise (ContErr "split of Leaf")
  in
    match l with
        Node lz -> 
          if d == dir then
            let (c',d'),l' = Zip.get lz in
            let s1,s2 = splitsize (c', dir) in
              ((c,d), Node (Zip.insert (empty s1) (Zip.replace ((s2,d'),l') lz))),p
          else
            let s1,s2 = splitsize (c, dir) in
              ((c,d), Node (Zip.insert (empty s1) (Zip.insert ((s2,d), Node lz) Zip.empty))),p
      | leaf -> 
          let s1,s2 = splitsize (c, dir) in
            ((c,d), Node (Zip.insert (empty s1) (Zip.insert ((s2,d), leaf) Zip.empty))),p

let rec merge (((pos,l),p) as c) = 
  let rec merge_aux = function
      Leaf wz -> Zip.to_list wz
    | Node lz -> List.fold_left (fun acc x -> x@acc) (List.concat (List.map merge_aux (List.map snd (Zip.to_list lz)))) []
  in
    match l with
        Leaf wz -> merge (_up c)
      | Node lz -> ((pos, Leaf (Zip.from_list (merge_aux (Node lz)))),p)
